home *** CD-ROM | disk | FTP | other *** search
/ Inter.Net 55-2 / Inter.Net 55-2.iso / Mandrake / mdkinst / usr / bin / perl-install / resize_fat / io.pm < prev    next >
Encoding:
Perl POD Document  |  2000-01-12  |  1.8 KB  |  75 lines
  1. package resize_fat::io;
  2.  
  3.  
  4.  
  5.  
  6. use resize_fat::fat;
  7.  
  8. 1;
  9.  
  10.  
  11. sub read($$$) {
  12.     my ($fs, $pos, $size) = @_;
  13.     my $buf = "\0" x $size;
  14.     sysseek $fs->{fd}, $pos, 0 or die "seeking to byte #$pos failed on device $fs->{fs_name}";
  15.     sysread $fs->{fd}, $buf, $size or die "reading at byte #$pos failed on device $fs->{fs_name}";
  16.     $buf;
  17. }
  18. sub write($$$$) {
  19.     my ($fs, $pos, $size, $buf) = @_;
  20.     sysseek $fs->{fd}, $pos, 0 or die "seeking to byte #$pos failed on device $fs->{fs_name}";
  21.     syswrite $fs->{fd}, $buf or die "writing at byte #$pos failed on device $fs->{fs_name}";
  22. }
  23.  
  24. sub read_cluster($$) {
  25.     my ($fs, $cluster) = @_;
  26.     my $buf;
  27.  
  28.     eval {
  29.     $buf = &read($fs,
  30.              $fs->{cluster_offset} + $cluster * $fs->{cluster_size},
  31.              $fs->{cluster_size});
  32.     }; @$ and die "reading cluster #$cluster failed on device $fs->{fs_name}";
  33.     $buf;
  34. }
  35. sub write_cluster($$$) {
  36.     my ($fs, $cluster, $buf) = @_;
  37.  
  38.     eval {
  39.     &write($fs,
  40.        $fs->{cluster_offset} + $cluster * $fs->{cluster_size},
  41.        $fs->{cluster_size},
  42.        $buf);
  43.     }; @$ and die "writing cluster #$cluster failed on device $fs->{fs_name}";
  44. }
  45.  
  46. sub read_file($$) {
  47.     my ($fs, $cluster) = @_;
  48.     my $buf = '';
  49.  
  50.     for (; !resize_fat::fat::is_eof($cluster); $cluster = resize_fat::fat::next ($fs, $cluster)) {
  51.     $cluster == 0 and die "Bad FAT: unterminated chain\n";
  52.     $buf .= read_cluster($fs, $cluster);
  53.     }
  54.     $buf;
  55. }
  56.  
  57. sub check_mounted($) {
  58.     my ($f) = @_;
  59.  
  60.     local *F;
  61.     open F, "/proc/mounts" or die "error opening /proc/mounts\n";
  62.     foreach (<F>) {
  63.     /^$f\s/ and die "device is mounted";
  64.     }
  65. }
  66.  
  67. sub open($) {
  68.     my ($fs) = @_;
  69.  
  70.     check_mounted($fs->{device});
  71.  
  72.     sysopen F, $fs->{fs_name}, 2 or sysopen F, $fs->{fs_name}, 0 or die "error opening device $fs->{fs_name} for writing\n";
  73.     $fs->{fd} = *F;
  74. }
  75.